home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / lalr.lha / lalr / src / Reduce.mi < prev   
Text File  |  1992-08-18  |  7KB  |  326 lines
  1. (* check if the grammar is reduced *)
  2.  
  3. (* $Id: Reduce.mi,v 2.2 1992/08/07 15:22:49 grosch rel $ *)
  4.  
  5. (* $Log: Reduce.mi,v $
  6.  * Revision 2.2  1992/08/07  15:22:49  grosch
  7.  * allow several scanner and parsers; extend module Errors
  8.  *
  9.  * Revision 2.1  1991/11/21  14:53:14  grosch
  10.  * new version of RCS on SPARC
  11.  *
  12.  * Revision 2.0  91/03/08  18:31:50  grosch
  13.  * turned tables into initialized arrays (in C)
  14.  * moved mapping tokens -> strings from Errors to Parser
  15.  * changed interface for source position
  16.  * 
  17.  * Revision 1.1  90/06/12  16:54:34  grosch
  18.  * renamed main program to lalr, added { } for actions, layout improvements
  19.  * 
  20.  * Revision 1.0     88/10/04  14:36:38  vielsack
  21.  * Initial revision
  22.  * 
  23.  *)
  24.  
  25. IMPLEMENTATION MODULE Reduce;
  26.  
  27.   FROM SYSTEM IMPORT
  28.     ADR;
  29.  
  30.   FROM Errors IMPORT
  31.     eWarning, eError, eIdent, ErrorMessage, ErrorMessageI;
  32.  
  33.   FROM Sets IMPORT
  34.     tSet,
  35.     MakeSet, ReleaseSet,
  36.     Include, Exclude,
  37.     Extract, 
  38.     IsElement, IsEmpty,
  39.     ForallDo;
  40.  
  41.   FROM Automaton IMPORT
  42.     tIndex,
  43.     tStateIndex,
  44.     tProdIndex,
  45.     tItemIndex,
  46.     StartSymbol,
  47.     tProduction,
  48.     ProdList,
  49.     ProdArrayPtr;
  50.  
  51.   FROM TokenTab IMPORT 
  52.     MINTerm, MAXTerm,
  53.     MINNonTerm, MAXNonTerm,
  54.     Vocabulary,
  55.     Terminal, NonTerminal,
  56.     PosType, GetTokenPos,
  57.     TokenError, TokenType,
  58.     GetTokenType, TokenToSymbol;
  59.   
  60.   FROM Idents IMPORT
  61.     tIdent;
  62.  
  63.   CONST
  64.     eNotReach    = 47;
  65.     eNoProd    = 46;
  66.     eNotTerm    = 45;
  67.  
  68.   PROCEDURE TestReduced;
  69.  
  70.   (* prueft ob die im Modul Automaton bekannte Grammatik
  71.      reduziert ist. Falls nein wird das Programm mittels einer
  72.      Fehlermeldung abgebrochen *)
  73.   
  74.     VAR
  75.       ok, okreach, okterm : BOOLEAN;
  76.       reached  : tSet;         (* erreichbare Symbole     *)
  77.  
  78.     BEGIN
  79.       MakeSet (reached,MAXNonTerm);
  80.       okreach := TestReach (reached);
  81.       okterm := TestTerm (reached);
  82.       ok := (* okreach AND *) okterm;     (* kein genereller Abbruch *)
  83.  
  84.       Reduced := ok;
  85.  
  86.       ReleaseSet (reached);
  87.     END TestReduced;
  88.  
  89.   PROCEDURE TestReach (reached: tSet) : BOOLEAN;
  90.  
  91.   (* Pruefe ob alle Vokabularzeichen erreichbar sind *)
  92.     
  93.     VAR
  94.       reach    : BOOLEAN;     (* Funktionsergebniss *)
  95.       t           : Terminal;
  96.       nt       : NonTerminal;
  97.       todo     : tSet;         (* noch zu bearbeiten *)
  98.       done     : tSet;         (* bereits bearbeitet *)
  99.       u, i     : tIndex;
  100.       pn       : tProdIndex;
  101.       prod     : tProduction;
  102.       ri,voc   : Vocabulary;
  103.       error    : TokenError;
  104.       sym      : tIdent;    (* zur Fehlerausgabe  *)
  105.       pos      : PosType;
  106.  
  107.  
  108.     BEGIN 
  109.       MakeSet (todo,MAXNonTerm);
  110.       MakeSet (done,MAXNonTerm);
  111.  
  112.       (* Startsymbol ist zu bearbeiten *)
  113.  
  114.       Include (todo,StartSymbol);
  115.       Include (reached,StartSymbol);
  116.  
  117.       (* Terminale sind nicht mehr zu bearbeiten *)
  118.  
  119.       FOR t := MINTerm TO MAXTerm DO
  120.     IF GetTokenType (t) = Term THEN
  121.       Include (done,t);
  122.     END;
  123.       END;
  124.  
  125.       REPEAT
  126.  
  127.     (* waehle ein Nichtterminal zur Bearbeitung aus *)
  128.  
  129.     nt := Extract (todo);
  130.     Include (done, nt);
  131.  
  132.     WITH ProdList[nt] DO
  133.       u := Used;
  134.  
  135.       (* fuer alle Produktionen mit linker Seite nt *)
  136.  
  137.       FOR pn := 1 TO u DO
  138.  
  139.         (* waehle aktuelle Produktion aus *)
  140.  
  141.         prod := ADR(ProdArrayPtr^[Array^[pn].Index]);
  142.         WITH prod^ DO
  143.  
  144.           (* alle Vocabularzeichen auf der rechten Seite werden *)
  145.           (* hiermit erreichbar *)
  146.  
  147.           FOR i := 1 TO Len DO
  148.         ri := Right [i];
  149.         Include (reached, ri);
  150.  
  151.         (* noch nicht erledigte Vokabularzeichen die rechts *)
  152.         (* auftreten sind zu bearbeiten *)
  153.  
  154.         IF NOT IsElement (ri, done) THEN
  155.           Include (todo, ri);
  156.         END;
  157.           END;
  158.         END;
  159.       END;
  160.     END;
  161.       UNTIL IsEmpty (todo);
  162.  
  163.       reach := TRUE;
  164.  
  165.       (* pruefe ob alle Vocabularzeichen erreichbar sind *)
  166.       (* gebe ggf. eine Fehlermeldung aus *)
  167.  
  168.       FOR voc := MINTerm TO MAXTerm DO
  169.     IF (GetTokenType (voc) <> None) AND
  170.        NOT IsElement (voc, reached) THEN
  171.       GetTokenPos    (voc,pos);
  172.       sym := TokenToSymbol (voc,error);
  173.       ErrorMessageI (eNotReach, eWarning, pos,eIdent, ADR (sym));
  174.     END;
  175.       END;
  176.  
  177.       FOR voc := MINNonTerm TO MAXNonTerm DO
  178.     IF (GetTokenType (voc) <> None) AND
  179.        NOT IsElement (voc, reached) THEN
  180.       GetTokenPos    (voc,pos);
  181.       sym := TokenToSymbol (voc,error);
  182.       ErrorMessageI (eNotReach, eWarning, pos, eIdent, ADR (sym));
  183.  
  184.       (* nichtereichbare Nichtterminal sind toetlich *)
  185.       reach := FALSE;
  186.  
  187.     END;
  188.       END;
  189.  
  190.       ReleaseSet (todo);
  191.       ReleaseSet (done);
  192.  
  193.       RETURN reach;
  194.     END TestReach;
  195.  
  196.  
  197.   PROCEDURE TestTerm (reached: tSet) : BOOLEAN;
  198.  
  199.   (* Pruefe ob alle Nichtterminale terminalisierbar sind *)
  200.  
  201.     VAR
  202.       todo : tSet;    (* noch zu ueberpruefende Nichterminale *)
  203.       done : tSet;    (* als terminalisierbar erkannte Vokabularzeichen *)
  204.       success : BOOLEAN; (* hatte der letzte Schritt erfolg *)
  205.       t : Terminal;
  206.       nt : NonTerminal;
  207.       term : BOOLEAN;
  208.       error : TokenError;
  209.       sym : tIdent;
  210.       pos : PosType;
  211.       kind : CARDINAL;
  212.  
  213.     PROCEDURE IsYetTerm (nt : CARDINAL);
  214.  
  215.       VAR
  216.     u, i : tIndex;
  217.     pn   : tProdIndex;
  218.     prod : tProduction;
  219.     ri   : Vocabulary;
  220.     t : Terminal;
  221.     localsuccess : BOOLEAN;
  222.  
  223.       BEGIN 
  224.     WITH ProdList[nt] DO
  225.       u := Used;
  226.  
  227.       (* Betrachte alle Produktionen mit linker Seite nt *)
  228.  
  229.       localsuccess := FALSE;
  230.       pn := 1;
  231.       WHILE (pn <= u) AND NOT localsuccess DO
  232.  
  233.         (* Auswahl der einzelnen Produktion *)
  234.  
  235.         prod := ADR(ProdArrayPtr^[Array^[pn].Index]);
  236.         WITH prod^ DO
  237.  
  238.           (* Pruefe ob rechte Seite in todo* liegt *)
  239.  
  240.           localsuccess := TRUE;
  241.           i := 1;
  242.           WHILE (i <= Len) AND localsuccess DO
  243.         ri := Right [i];
  244.         localsuccess := IsElement (ri,done);
  245.         INC (i);
  246.           END;
  247.  
  248.         END;
  249.  
  250.         INC (pn);
  251.       END;
  252.     END;
  253.  
  254.     IF localsuccess THEN
  255.       Include (done, nt);
  256.       Exclude (todo, nt);
  257.       success := TRUE
  258.     END;
  259.  
  260.       END IsYetTerm;
  261.  
  262.     BEGIN 
  263.       MakeSet (todo,MAXNonTerm);
  264.       MakeSet (done,MAXNonTerm);
  265.  
  266.       (* todo = Menge aller Nichtterminale *)
  267.  
  268.       FOR nt := MINNonTerm TO MAXNonTerm DO
  269.     IF GetTokenType (nt) = NonTerm THEN
  270.       Include (todo,nt);
  271.     END;
  272.       END;
  273.  
  274.       (* done := Menge alle Terminale *)
  275.  
  276.       FOR t := MINTerm TO MAXTerm DO
  277.     IF GetTokenType (t) = Term THEN
  278.       Include (done,t);
  279.     END;
  280.       END;
  281.  
  282.       REPEAT
  283.  
  284.     success := FALSE;
  285.  
  286.     (* Pruefe ob jetzt ein weiteres *)
  287.     (* Nichtterminal terminalisierbar ist *)
  288.  
  289.     FOR nt := MINNonTerm TO MAXNonTerm DO
  290.       IF IsElement (nt, todo) THEN
  291.         IsYetTerm (nt);
  292.       END;
  293.     END;
  294.       UNTIL NOT success;    (* solange bis sich nichts aendert *)
  295.  
  296.       term := TRUE;
  297.       IF NOT IsEmpty (todo) THEN
  298.     REPEAT 
  299.       nt := Extract (todo);
  300.  
  301.       (* Ein ereichbares Nichtterminal, das nicht terminalisiserbar
  302.          ist, fuehrt zum Abbruch *)
  303.       IF IsElement (nt, reached) THEN
  304.         term := FALSE;
  305.         kind := eError;
  306.       ELSE
  307.         kind := eWarning;
  308.       END;
  309.       GetTokenPos    (nt,pos);
  310.       sym := TokenToSymbol (nt,error);
  311.       IF ProdList[nt].Used = 0 THEN
  312.         ErrorMessageI (eNoProd, kind, pos, eIdent, ADR (sym));
  313.       ELSE
  314.         ErrorMessageI (eNotTerm, kind, pos, eIdent, ADR (sym));
  315.       END;
  316.     UNTIL IsEmpty (todo);
  317.       END;
  318.  
  319.       ReleaseSet (todo);
  320.       ReleaseSet (done);
  321.  
  322.       RETURN term;
  323.     END TestTerm;
  324.  
  325. END Reduce.
  326.